home *** CD-ROM | disk | FTP | other *** search
/ MacWorld UK 2000 March / MW_UK_2000_03.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Menus / filesetsMenu.tcl < prev    next >
Encoding:
Text File  |  1999-11-16  |  48.4 KB  |  1,658 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "filesetsMenu.tcl"
  6.  #                    created: 20/7/96 {6:22:25 pm} 
  7.  #                   last update: 11/16/1999 {19:23:10 PM} 
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <vince@santafe.edu>
  10.  #      mail:    317 Paseo de Peralta, Santa Fe, NM 87501, USA
  11.  #       www:    <http://www.santafe.edu/~vince/>
  12.  #    
  13.  #==============================================================================
  14.  # Alpha calls two fileset-related routines, 'getCurrFileSet', and 
  15.  # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
  16.  # on occasion, but this isn't critical.
  17.  #==============================================================================
  18.  # 
  19.  #  modified by  rev reason
  20.  #  -------- --- --- -----------
  21.  #  24/3/96  VMD 1.0 update of Pete's original to allow mode-specific filesets
  22.  #  27/3/96  VMD 1.1 added hierarchial filesets, and checks for unique menus
  23.  #  13/6/96  VMD 1.2 memory efficiency improvements with 'fileSets' array
  24.  #  10/3/97  VMD 1.3 added 'procedural' fsets, including 'Open Windows'
  25.  #  6/4/97   VMD 1.31 various fixes incorporated - thanks!
  26.  #  11/7/97  VMD 1.4 added cache for the fileset menu, improved wc proc.
  27.  #  15/7/97  VMD 1.41 better handling of out-of-date filesets, and dir opening
  28.  #  15/7/97  VMD 1.42 placed cache in separate file.
  29.  #  21/7/97  VMD 1.43 added glob patterns to ignore for directory filesets
  30.  #  22/7/97  VMD 1.5 more sophisticated menu caching.  No more long rebuilds!
  31.  #  10/9/97  VMD 1.6 simplified some stuff for new Alpha-Tcl
  32.  #  7/12/97  VMD 1.6.1 makes use of winNumDirty flag
  33.  #  12/1/98  VMD 1.6.2 removes special treatment of *recent*
  34.  #  15/1/1999  VMD 1.7.2 a year of improvements....
  35.  # ###################################################################
  36.  ##
  37.  
  38. ## 
  39.  # These procedures are now more robust and general-purpose.  Basic new
  40.  # features are:
  41.  # 
  42.  #  * user configurable menu * unique-menu names are ensured, so there can
  43.  #  be no clashes * new fileset types ('tex' and 'fromHierarchy') * new
  44.  #  utility functions ('stuff', 'wordCount',...)  * filesets need not
  45.  #  appear in the menu; in fact they can be anywhere you like
  46.  #          
  47.  # Known Bugs:
  48.  # 
  49.  #  You cannot have a hierarchial fileset which contains more than one
  50.  #  folder with the same name as the fileset, including the base folder. 
  51.  #  This is very hard to fix, and the easy workaround is just to rename the
  52.  #  fileset in some minor way.
  53.  ##
  54.  
  55. alpha::menu filesetMenu 1.7.5 global "•131" {
  56. } {filesetMenu} {} uninstall {this-file} help {file "Filesets Help"}
  57.  
  58. proc filesetMenu {} {}
  59.  
  60. # Build some filesets on the fly.
  61. set gfileSets(Help) [file join $HOME Help *]
  62. set gfileSets(System) [list [file join $HOME Tcl SystemCode *.tcl] 2]
  63. set gfileSets(Menus) [list [file join $HOME Tcl Menus *.tcl] 2]
  64. set gfileSets(Modes) [list [file join $HOME Tcl Modes *.tcl] 2]
  65.  
  66. # Declare their types
  67. set gfileSetsType(Help) "fromDirectory"
  68. set gfileSetsType(System) "fromHierarchy"
  69. set gfileSetsType(Modes) "fromHierarchy"
  70. set gfileSetsType(Menus) "fromHierarchy"
  71.  
  72. proc filesetRegisterProcedural {name proc} {
  73.     global gfileSets gfileSetsType
  74.     set gfileSets($name) $proc
  75.     set gfileSetsType($name) "procedural"
  76. }
  77.  
  78. filesetRegisterProcedural "Open Windows" procFilesetOpenWindows
  79. filesetRegisterProcedural "Top Window's Folder" procFilesetDirTopWin
  80. filesetRegisterProcedural "Recurse in folder…" procFilesetRecurseIn
  81.  
  82. # Procs for procedural filesets
  83. proc procFilesetRecurseIn {} {
  84.     return [file::recurse [get_directory -p "Search recursively in which folder?"]]
  85. }
  86.  
  87. proc procFilesetOpenWindows {} { return [winNames -f] }
  88. proc procFilesetDirTopWin {} { 
  89.     if {[set w [win::Current]] == ""} {
  90.     return ""
  91.     } else {
  92.     return [glob -t TEXT -nocomplain -dir [file dirname [win::Current]] *]
  93.     }
  94. }
  95.  
  96. if {![file exists [file join $HOME Tcl Packages]]} { file mkdir [file join $HOME Tcl Packages] }
  97. set gfileSets(Packages) [list [file join $HOME Tcl Packages *.tcl] 2]
  98. set gfileSetsType(Packages) "fromHierarchy"
  99.  
  100. lunion varPrefs(Files) currFileSet
  101. # Default curr fileset is the first one. 
  102. newPref var currFileSet "System" global changeFileSet gfileSets array
  103.  
  104. # ◊◊◊◊ Variables and flags ◊◊◊◊ #
  105.  
  106. #################################################
  107. # Any of these can be over-ridden by the stored #
  108. # definitions in defs.tcl, arrdefs.tcl          #
  109. #################################################
  110.  
  111. ## 
  112.  # We don't show the 'help' fileset, since it's under the MacOS AppleGuide
  113.  # menu.  Also we could perhaps yank tex-filesets away into their own menu,
  114.  # in which case the tex-system could add to this variable as it went
  115.  # along.
  116.  ##
  117. lunion filesetsNotInMenu "Help" "Open Windows" "Top Window's Folder" \
  118.   "Recurse in folder…"
  119.  
  120. ## 
  121.  # A type is a means of    generating a fileset given its 
  122.  # description in the variable 'gfileSets(name)':
  123.  ##
  124. lunion fileSetsTypes "list" "glob" "fromHierarchy" "procedural"
  125.  
  126. ## 
  127.  # A menu type is a means of prompting the user and characterising the
  128.  # interface to a type, even though the actual storage may be very simple
  129.  # (a list in most cases).
  130.  ##
  131. set fileSetsTypesThing(fromDirectory) "glob"
  132. set fileSetsTypesThing(fromHierarchy) "fromHierarchy"
  133. set fileSetsTypesThing(think) "list"
  134. set fileSetsTypesThing(codewarrior) "list"
  135. set fileSetsTypesThing(ftp) "list"
  136. set fileSetsTypesThing(fromOpenWindows) "list"
  137. set fileSetsTypesThing(procedural) "procedural"
  138.  
  139. ## 
  140.  # To add a new fileset type, you need to define the following:
  141.  #       set fileSetsTypesThing(myType) "list"
  142.  #       proc    myTypeCreateFileset    {} {}
  143.  #       proc    myTypeFilesetUpdate    {name} {}
  144.  # 
  145.  # For more complex types (e.g. the tex-type), define as follows:
  146.  #       set fileSetsTypesThing(myType) "myType"
  147.  #       proc    myTypeCreateFileset    {} {}
  148.  #       proc    myTypeFilesetSelected {    fset menu item }    {}
  149.  #       proc    myTypeFilesetUpdate    { name } {}
  150.  #       proc    myTypeListFilesInFileset { name    } {}
  151.  #       proc    myTypeMakeFileSetSubMenu { name    } {}
  152.  # 
  153.  # These procedures will all be called automatically under the correct
  154.  # circumstances.  The purposes of these are as follows:
  155.  #
  156.  #   'create'   -- query the user for name etc. and create
  157.  #   'update'   -- given the information in 'gfileSets', recalculate
  158.  #                   the member files.
  159.  #   'selected' -- a member was selected in a menu.
  160.  #   'list'     -- given info in all except 'fileSets', return list
  161.  #                 of files to be stored in that variable.
  162.  #   'submenu'  -- generate the sub-menu
  163.  # 
  164.  # Your code may wish to call 'isWindowInFileset ?win?  ?type?'  to check
  165.  # if a given (current by default) window is in a fileset of a given type.
  166.  ##
  167.  
  168. ## 
  169.  # -------------------------------------------------------------------------
  170.  #     
  171.  #    "filesetSortOrder" --
  172.  #    
  173.  #   The structure of this variable dictates how the fileset menu is
  174.  #   structured:
  175.  #           
  176.  #           '{pattern p}' 
  177.  #               lists all filesets which    match 'p'
  178.  #           '-' 
  179.  #               adds    a separator    line
  180.  #           '{list of types}' 
  181.  #               lists all filesets of those types.
  182.  #           '{submenu name sub-order-list}' 
  183.  #               adds    a submenu with name    'name' and recursively
  184.  #               adds    filesets to    that submenu as    given by the 
  185.  #               sub-order.
  186.  #               
  187.  #       Leading,    trailing and double    separators are automatically
  188.  #       removed.
  189.  #     
  190.  # -------------------------------------------------------------------------
  191.  ##
  192. ensureset filesetSortOrder { {pattern *System} {pattern Packages} \
  193.     {pattern Menus} {pattern Modes} {pattern Preferences} \
  194.     - {tex} - {pattern *.cc} {submenu Headers {pattern *.h}} \
  195.     - {fromDirectory think codewarrior ftp \
  196.     fromOpenWindows fromHierarchy} * } 
  197.  
  198. set    "filesetUtils(browseFileset…)" [list * browseFileset]
  199. set    "filesetUtils(renameFileset…)" [list * renameFileset]
  200. set    "filesetUtils(openEntireFileset…)" [list * openEntireFileset]
  201. set    "filesetUtils(filesetToAlpha…)" [list * filesetToAlpha]
  202. set    "filesetUtils(closeEntireFileset…)" [list * closeEntireFileset]
  203. set    "filesetUtils(replaceInFileset…)" [list * replaceInFileset]
  204. set    "filesetUtils(stuffFileset…)" [list * stuffFileset]
  205. set    "filesetUtils(wordCount)" [list * wordCountFileset]
  206. set    "filesetUtils(openFilesetFolder…)" [list * openFilesetFolder]
  207.  
  208.  
  209. ## 
  210.  # The meaning of these    flags is as    follows:
  211.  #       sortFilesetItems    -- 
  212.  #           a type can have the option of being unsorted    (e.g. tex-filesets)
  213.  #       indentFilesetItems --
  214.  #           visual formatting may be    of relevance to    some types
  215.  #       sortFilesetsByType -- 
  216.  #           use the variable    'filesetSortOrder' to determine    the
  217.  #           visual structure    of the fileset menu
  218.  #       autoAdjustFileset --
  219.  #           when    a file is selected from    the    menu, do we    try    and    
  220.  #           keep    'currFileSet' accurate?
  221.  #       includeNonTextFiles --
  222.  #           filesets may include non-text files.  Alpha will tell the
  223.  #           finder to open these if they are selected.
  224.  ##        
  225. newPref flag sortFilesetItems 0 "fileset"
  226. newPref flag indentFilesetItems 0 "fileset"
  227. newPref flag sortFilesetsByType 0 "fileset" rebuildSomeFilesetMenu
  228. newPref flag autoAdjustFileset 1 "fileset"
  229. newPref flag includeNonTextFiles 0 "fileset" rebuildSomeFilesetMenu
  230.  
  231. # To add a new fileset type, all we have to do is this:
  232. # set fileSetsTypesThing(tex) "tex"
  233. # lappend fileSetsTypes "tex"
  234. # If you create new types just add lines like that
  235.  
  236. #===========================================================================
  237. # The support routines.
  238. #===========================================================================
  239. # Called from Alpha to get list of files for current file set.
  240. proc getCurrFileSet {} {
  241.     global currFileSet
  242.     return [getFileSet $currFileSet]
  243. }
  244.  
  245. # Called from Alpha to get names.  The first name returned is taken to
  246. # be the current fileset.  For Alpha < 8.0, the list returned contains
  247. # the first item twice (as the first item, and then in its correct 
  248. # position in the list).  For Alpha >= 8.0 this silly behaviour has 
  249. # been removed.
  250. proc getFileSetNames {{ordered 0}} {
  251.     global gfileSets currFileSet gDirScan
  252.     set perm {}
  253.     if {!$ordered && $currFileSet != ""} {
  254.     lappend perm $currFileSet
  255.     }
  256.     foreach n [lsort -ignore [array names gfileSets]] {
  257.     if {!$ordered && ([info tclversion] >= 8.0) && $n == $currFileSet} {continue}
  258.     if {[info exists gDirScan($n)]} {
  259.         lappend temp $n
  260.     } else {
  261.         lappend perm $n
  262.     }
  263.     }
  264.     if {[info exists temp]} {
  265.     return [concat $perm - $temp]
  266.     } else {
  267.     return $perm
  268.     }
  269. }
  270.  
  271. #================================================================================
  272. # Edit a file from a fileset via list dialogs (no mousing around).
  273. #================================================================================
  274. proc editFile {} {
  275.     global currFileSet modifiedVars gfileSetsType file::separator
  276.     
  277.     if {[catch {pickFileset "" {Fileset?} "list"} fset]} {return}
  278.     set currFileSet $fset
  279.     lappend modifiedVars currFileSet
  280.     
  281.     set ff [getFilesInSet $fset]
  282.     foreach f $ff {
  283.     lappend disp [file tail $f]
  284.     }
  285.     if {[catch {listpick -l -p {File?} [lsort -ignore $disp]} files]} {return}
  286.     foreach res $files {
  287.     set ind [lsearch $ff "\*${file::separator}$res"]
  288.     if {$gfileSetsType($fset) == "ftp"} {
  289.         ftpFilesetOpen $fset [lindex $ff $ind]
  290.     } else {
  291.         catch {generalOpenFileitem [lindex $ff $ind]}
  292.     }
  293.     }
  294. }
  295.  
  296. # We only return TEXT files, since we don't want Alpha
  297. # manipulating the data fork of non-text files.
  298. proc getFileSet {fset} {
  299.     global filesetmodeVars
  300.     if {$filesetmodeVars(includeNonTextFiles)} {
  301.     set fnames ""
  302.     foreach f [getFilesInSet $fset] {
  303.         if {[file isfile $f]} {
  304.         getFileInfo $f a
  305.         if {$a(type) == "TEXT"} {
  306.             lappend fnames $f
  307.         }
  308.         }
  309.     }
  310.     return $fnames
  311.     } else {
  312.     return [getFilesInSet $fset]
  313.     }
  314. }
  315.  
  316. proc browseFileset {{fset ""}} {
  317.     global tileLeft tileTop tileWidth errorHeight
  318.     
  319.     if {[catch {pickFileset $fset {Fileset?}} fset]} {return}
  320.     
  321.     foreach f [getFilesInSet $fset] {
  322.     lappend text "\t[file tail $f]\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f"
  323.     }
  324.     new -n "* FileSet '$fset' Browser *" -g $tileLeft $tileTop 200 $errorHeight \
  325.       -m Brws -info "(<cr> to go to file)\r-----\r[join $text \r]"
  326.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  327.     message ""
  328. }    
  329.  
  330. # ◊◊◊◊ Basic procedures ◊◊◊◊ #
  331.  
  332. namespace eval fileset {}
  333.  
  334. # under development
  335. proc newFileset {} {
  336.     global currFileSet gfileSetsType fileSetsTypesThing modifiedArrayElements
  337.     foreach type  {
  338.     lappend dialog -n $type 
  339.     }
  340.     set res [dialog::paged -pageproc fileset::page \
  341.       [lsort -ignore [array names fileSetsTypesThing]]]
  342.  
  343.     if {![string length $name]} return
  344.     
  345.     lappend modifiedArrayElements [list $name gfileSetsType]
  346.     set gfileSetsType($name) $type
  347.     
  348.     set currFileSet $name
  349.     filesetsJustChanged $type $name
  350.     return $currFileSet
  351. }
  352.  
  353. proc fileset::page {fset x y} {
  354.     return [fileset::create$fset $x $y]
  355. }
  356.  
  357. proc newFileset {{type ""}} {
  358.     global currFileSet gfileSetsType fileSetsTypesThing modifiedArrayElements
  359.     if {$type == ""} {
  360.     set type [dialog::optionMenu "New fileset type?" \
  361.       [lsort -ignore [array names fileSetsTypesThing]] "fromDirectory"]
  362.     }
  363.     set name [eval ${type}CreateFileset]
  364.  
  365.     if {![string length $name]} return
  366.     
  367.     lappend modifiedArrayElements [list $name gfileSetsType]
  368.     set gfileSetsType($name) $type
  369.     
  370.     set currFileSet $name
  371.     filesetsJustChanged $type $name
  372.     return $currFileSet
  373. }
  374.  
  375.  
  376. ## 
  377.  # -------------------------------------------------------------------------
  378.  # 
  379.  # "filesetsJustChanged" --
  380.  # 
  381.  #  If we've added, deleted, modified a fileset, we call this procedure.
  382.  #  In most cases we must rebuild everything (due to limitations in Alpha),
  383.  #  but for 'procedural' filesets, we can just do the utilities menu.
  384.  # -------------------------------------------------------------------------
  385.  ##
  386. proc filesetsJustChanged {type name} {
  387.     if {$type == "procedural"} {
  388.     global filesetsNotInMenu modifiedVars
  389.     if {[lsearch $filesetsNotInMenu $name] == -1} {
  390.         lappend filesetsNotInMenu $name
  391.         lappend modifiedVars filesetsNotInMenu
  392.     }
  393.     rebuildFilesetUtilsMenu
  394.     } else {
  395.     rebuildAllFilesets 1
  396.     }
  397. }
  398.  
  399. proc printFileset { {fset ""}} {
  400.     if {[catch {pickFileset $fset "Print which Fileset?"} fset]} {return}
  401.     foreach f [getFilesInSet $fset] {
  402.     print $f
  403.     }
  404. }
  405.  
  406.  
  407. proc deleteFileset { {fset ""} {yes 0} } {
  408.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  409.     global filesetMenu subMenuFilesetInfo subMenuInfo filesetsNotInMenu
  410.     global modifiedVars modifiedArrayElements
  411.     
  412.     if {[catch {pickFileset $fset "Delete which Fileset?"} fset]} {return}
  413.     if {$currFileSet == $fset} {catch {set currFileSet System}}
  414.     
  415.     if {$yes || [dialog::yesno "Delete fileset \"$fset\"?"]} {
  416.     catch {unset "fileSetsExtra($fset)"}
  417.     catch {unset "gfileSetsType($fset)"}
  418.     catch {unset "fileSets($fset)"}
  419.     catch {unset "gfileSets($fset)"}
  420.     
  421.     lappend modifiedArrayElements \
  422.       [list $fset gfileSetsType] [list $fset fileSetsExtra] \
  423.       [list $fset gfileSets]
  424.     
  425.     set err [catch {removeFilesetFromMenu $fset}]
  426.     
  427.     if {[set l [lsearch -exact $filesetsNotInMenu $fset]] != -1} {
  428.         set filesetsNotInMenu [lreplace $filesetsNotInMenu $l $l]
  429.         lappend modifiedVars filesetsNotInMenu
  430.         deleteMenuItem -m choose $fset
  431.         deleteMenuItem -m hideFileset $fset
  432.         return
  433.     }
  434.     if {$err} {
  435.         # it's on a submenu or somewhere else so we just have
  436.         # to do the lot!
  437.         if {!$yes} { rebuildAllFilesets 1 }
  438.     } else {
  439.         deleteMenuItem -m choose $fset
  440.         deleteMenuItem -m hideFileset $fset
  441.     }
  442.     }
  443. }
  444.  
  445. proc removeFilesetFromMenu {fset} {
  446.     global subMenuFilesetInfo subMenuInfo
  447.     # find its menu:
  448.     if {[info exists subMenuFilesetInfo($fset)]} {
  449.     foreach m $subMenuFilesetInfo($fset) {
  450.         # remove info about it's name
  451.         if {[info exists subMenuInfo($m)]} {
  452.         unset subMenuInfo($m)
  453.         cache::add filesetMenuCache "eval" [list unset subMenuInfo($m)]
  454.         }
  455.     }
  456.     set base [lindex $subMenuFilesetInfo($fset) 0]
  457.     unset subMenuFilesetInfo($fset)
  458.     cache::add filesetMenuCache "eval" [list unset subMenuFilesetInfo($fset)]
  459.     cache::snippetRemove $fset
  460.     # this will fail if it's on a submenu or if it isn't a menu at all
  461.     deleteMenuItem -m $filesetMenu $base
  462.     cache::add filesetMenuCache "eval" [list deleteMenuItem -m $filesetMenu $base]
  463.     } else {
  464.     # I think I do nothing
  465.     }
  466.     
  467. }
  468.  
  469. ## 
  470.  # -------------------------------------------------------------------------
  471.  #     
  472.  #    "pickFileset" --
  473.  #    
  474.  # Ask the user for a/several filesets.  If 'fset' is set, we just return
  475.  # that (this avoids 'if {$fset != ""} { set fset [pick...]  } constructs
  476.  # everywhere).  A prompt can be given, and a dialog type (either a
  477.  # listpick, a pop-up menu, or a listpick with multiple selection), and
  478.  # extra items can be added to the list if desired. 
  479.  # -------------------------------------------------------------------------
  480.  ##
  481. proc pickFileset { fset {prompt Fileset?} {type "list"} {extras {}} } {
  482.     global gfileSets currFileSet
  483.     if { $fset != "" } { return $fset }
  484.     switch -- $type {
  485.     "popup" {
  486.         set fset [eval [list prompt $prompt \
  487.           $currFileSet "FileSet:"] [lsort -ignore [array names gfileSets]]]
  488.         if {![info exists gfileSets($fset)]} { error "No such fileset" }
  489.         return $fset
  490.     }
  491.     "list" {
  492.         return [listpick -p $prompt -L $currFileSet \
  493.           [lsort -ignore [concat $extras [array names gfileSets]]]]
  494.     }
  495.     "multilist" {
  496.         return [listpick -p $prompt -l -L $currFileSet \
  497.           [lsort -ignore [concat $extras [array names gfileSets]]]]
  498.     }        
  499.     }
  500. }
  501.  
  502. proc renameFileset {} {
  503.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  504.     global fileSetsTypesThing modifiedArrayElements
  505.     
  506.     if {[catch {pickFileset "" {Fileset to rename?}} fset]} {return}
  507.     
  508.     set name [getline "Rename to:" $fset]
  509.     if {![string length $name] || $name == $fset} return
  510.     
  511.     set gfileSets($name) $gfileSets($fset)
  512.     set gfileSetsType($name) $gfileSetsType($fset)
  513.     catch {set fileSets($name) $fileSets($fset)}
  514.     catch {set fileSetsExtra($name) $fileSetsExtra($fset)}
  515.     
  516.     deleteFileset $fset 1
  517.     
  518.     lappend modifiedArrayElements [list $name gfileSets]
  519.     lappend modifiedArrayElements [list $name gfileSetsType]
  520.     lappend modifiedArrayElements [list $name fileSetsExtra]
  521.     
  522.     filesetsJustChanged $gfileSetsType($name) $name
  523.     set currFileSet $name
  524. }
  525.  
  526. proc updateCurrentFileset {} {
  527.     global currFileSet
  528.     updateAFileset $currFileSet
  529. }
  530.  
  531. proc updateAFileset { {fset ""} } {
  532.     if {[catch {pickFileset $fset} fset]} {return}
  533.     
  534.     global gfileSetsType fileSets subMenuFilesetInfo subMenuInfo
  535.     
  536.     set type $gfileSetsType($fset)
  537.     catch {eval [list "${type}FilesetUpdate" $fset] }
  538.     set m [makeFileSetAndMenu $fset 1]
  539.     # we could rebuild the menu with this: but we don't
  540.     cache::add filesetMenuCache "eval" $m
  541.     if {[info exists subMenuFilesetInfo($fset)]} {
  542.     # if the fileset already has a base menu, use that:
  543.     foreach n $subMenuFilesetInfo($fset) {
  544.         cache::add filesetMenuCache "variable" subMenuInfo($n)
  545.     }
  546.     cache::add filesetMenuCache "variable" subMenuFilesetInfo($n)
  547.     }
  548.     if {[info exists fileSets($fset)]} {
  549.     cache::add filesetMenuCache "variable" fileSets($fset)
  550.     }
  551.     eval $m
  552.     callFilesetUpdateProcedures $fset
  553.     message "Done"
  554. }
  555.  
  556. proc callFilesetUpdateProcedures { {fset ""} } {
  557.     global filesetUpdateProcs gfileSetsType
  558.     if { $fset == "" } {
  559.     set types [array names filesetUpdateProcs]
  560.     } else {
  561.     set types $gfileSetsType($fset)
  562.     }
  563.     
  564.     foreach l $types {
  565.     if {[info exists filesetUpdateProcs($l)]} {
  566.         foreach proc $filesetUpdateProcs($l) {
  567.         uplevel \#0 $proc
  568.         }
  569.     }
  570.     }
  571.     
  572. }
  573.  
  574. # ◊◊◊◊ Creation of basic fileset types ◊◊◊◊ #
  575.  
  576. proc proceduralCreateFileset {} {
  577.     global gfileSets gfileSetsType filesetsNotInMenu modifiedArrayElements
  578.     set name [getline "Name for this fileset…"]
  579.     if {![string length $name]} return
  580.     set gfileSetsType($name) "procedural"
  581.     set p procFileset[join $name ""]
  582.     set gfileSets($name) $p
  583.     addUserLine "\# procedure to list files in fileset '$name' on the fly"
  584.     addUserLine "proc $p \{\} \{"
  585.     addUserLine "\t"
  586.     addUserLine "\}"
  587.     lappend modifiedArrayElements [list $name gfileSets]
  588.     lappend modifiedArrayElements [list $name gfileSetsType]
  589.     if {[dialog::yesno "I've added a template for the procedure to your 'prefs.tcl'. Do you want to edit it now?"]} {
  590.     global::editPrefsFile
  591.     goto [maxPos]
  592.     beep
  593.     message "Make sure you 'load' the new procedure."
  594.     }
  595.     lappend filesetsNotInMenu $name
  596.     return $name
  597. }
  598.  
  599. # under development
  600. proc fileset::createfromDirectory {x y} {
  601.     eval lappend dial \
  602.       [dialog::edit "New fileset name:" $x y 20] \
  603.       [dialog::edit "New fileset dir:" $x y 20] \
  604.       [dialog::edit "File pattern:" $x y 20]
  605. }
  606.  
  607. proc fromDirectoryCreateFileset {} {
  608.     global gfileSets gfileSetsType fileSetsExtra
  609.     
  610.     set name [getFilesetDirectoryAndPattern]
  611.     if {![string length $name]} return
  612.     set filePatIgnore [getline "List of file patterns to ignore:" ""]
  613.     if {$filePatIgnore != ""} {
  614.     set fileSetsExtra($name) $filePatIgnore
  615.     }
  616.     
  617.     set gfileSetsType($name) "fromDirectory"
  618.     
  619.     if {[dialog::yesno "Save new fileset?"]} {
  620.     global modifiedArrayElements
  621.     lappend modifiedArrayElements [list $name gfileSets]
  622.     lappend modifiedArrayElements [list $name gfileSetsType]
  623.     if {[info exists fileSetsExtra($name)]} {
  624.         lappend modifiedArrayElements [list $name fileSetsExtra]
  625.     }
  626.     }
  627.     return $name
  628. }
  629.  
  630. proc getFilesetDirectoryAndPattern {} {
  631.     global gfileSets fileSetsExtra
  632.     set name [getline "New fileset name:" ""]
  633.     if {![string length $name]} return
  634.     
  635.     set dir [get_directory -p "New fileset dir:"]
  636.     if {![string length $dir]} return
  637.     
  638.     set filePat [getline "File pattern:" "*"]
  639.     if {![string length $filePat]} return
  640.     
  641.     set gfileSets($name) [file join $dir $filePat]
  642.     return $name
  643. }
  644.  
  645. proc fromDirectoryFilesetUpdate {name} {
  646.     # done on the fly so no need to update
  647.     #global fileSets gfileSets
  648.     #set fileSets($name) [glob -t TEXT -nocomplain "$gfileSets($name)"]
  649. }
  650.  
  651. proc fromHierarchyCreateFileset {} {
  652.     global gfileSets gfileSetsType    
  653.     
  654.     set name [getFilesetDirectoryAndPattern]
  655.     if {![string length $name]} return
  656.     
  657.     set gfileSetsType($name) "fromHierarchy"
  658.     set depth [listpick -p "Depth of hierarchy?" -L 3 {1 2 3 4 5 6 7}]
  659.     if { $depth == "" } {set depth 3}
  660.     
  661.     set gfileSets($name) [list $gfileSets($name) $depth]
  662.     
  663.     if {[dialog::yesno "Save new fileset?"]} {
  664.     global modifiedArrayElements
  665.     lappend modifiedArrayElements [list $name gfileSets] \
  666.       [list $name gfileSetsType]
  667.     }
  668.     return $name
  669. }
  670.  
  671. proc fromHierarchyFilesetUpdate {name} {
  672.     fromHierarchyMakeFileSetAndMenu $name 0
  673. }
  674.  
  675. proc fromHierarchyMakeFileSetAndMenu {name andMenu} {
  676.     global filesetTemp fileSets gfileSets
  677.     set dir [file dirname [lindex $gfileSets($name) 0]]
  678.     set patt [file tail [lindex $gfileSets($name) 0]]
  679.     set depth [lindex $gfileSets($name) 1]
  680.     # we make the menu as a string, but can bin it if we like
  681.     set menu [menu::buildHierarchy [list $dir] $name filesetProc filesetTemp $patt $depth $name]
  682.     
  683.     # we need to construct the list of items
  684.     set fileSets($name) {}
  685.     if {[info exists filesetTemp]} {
  686.     foreach n [array names filesetTemp] {
  687.         lappend fileSets($name) $filesetTemp($n)
  688.     }
  689.     unset filesetTemp
  690.     }
  691.     return $menu
  692. }
  693.  
  694. proc fromHierarchyFilesetSelected {fset menu item} {
  695.     global gfileSets
  696.     set dir [file dirname [lindex $gfileSets($fset) 0]]
  697.     set ff [getFilesInSet $fset]
  698.     if { $fset == $menu } {
  699.     # it's top level
  700.     if {[set match [lsearch $ff [file join ${dir} $item]]] >= 0} {
  701.         autoUpdateFileset $fset
  702.         generalOpenFileitem [lindex $ff $match]
  703.         return
  704.     }
  705.     }
  706.     # the following two are slightly cumbersome, but give us the best
  707.     # chance of finding the correct file given any ambiguity (which can
  708.     # certainly arise if file and directory names clash excessively).
  709.     if {[set match [lsearch $ff [file join ${dir} ${menu} $item]]] >= 0} {
  710.     autoUpdateFileset $fset
  711.     generalOpenFileitem [lindex $ff $match]
  712.     return
  713.     }
  714.     if {[set match [lsearch $ff [file join ${dir} * ${menu} $item]]] >= 0} {
  715.     autoUpdateFileset $fset
  716.     generalOpenFileitem [lindex $ff $match]
  717.     return
  718.     }
  719.     error "Weird! Couldn't find it."
  720. }
  721.  
  722.  
  723. proc codewarriorCreateTagFile {} { return [alphaCreateTagFile] }
  724. proc thinkCreateTagFile {} { return [alphaCreateTagFile] }
  725.  
  726. proc fromOpenWindowsCreateFileset {} {
  727.     global gfileSets modifiedArrayElements
  728.     
  729.     set name [prompt "Create fileset containing current windows under what name?" "OpenWins"]
  730.     
  731.     set gfileSets($name) [winNames -f]
  732.     lappend modifiedArrayElements [list $name gfileSets]
  733.     
  734.     return $name
  735. }
  736.  
  737.  
  738. # ◊◊◊◊ Menu procedures ◊◊◊◊ #
  739.  
  740. ## 
  741.  # Global procedures to    deal with the fact that    Alpha can only have    one
  742.  # menu    with each given    name.  This    is only    a problem in dealing with
  743.  # user-defined    menus such as fileset menus, tex-package menus,    ...
  744.  ##
  745.  
  746. ## 
  747.  # -------------------------------------------------------------------------
  748.  #     
  749.  #    "makeFilesetSubMenu" --
  750.  #    
  751.  # If desired this is the only procedure you need use --- it returns a menu
  752.  # creation string, taking account of the unique name requirement and will
  753.  # make sure your procedure 'proc' is called with the real menu name! 
  754.  # -------------------------------------------------------------------------
  755.  ##
  756. proc makeFilesetSubMenu {fset name proc args} {
  757.     if { [string length $proc] > 1 } {
  758.     return [concat {Menu -m -n} [list [registerFilesetMenuName $fset $name $proc]] -p subMenuProc $args]
  759.     } else {
  760.     return [concat {Menu -m -n} [list [registerFilesetMenuName $fset $name]] $args]
  761.     }
  762. }
  763.  
  764. ## 
  765.  # -------------------------------------------------------------------------
  766.  #     
  767.  #    "registerFilesetMenuName" --
  768.  #    
  769.  # Call to ensure unique fileset submenu names.  We just add spaces as
  770.  # appropriate and keep track of everything for you!  Filesets which have
  771.  # multiple menus _must_ register the main menu first. 
  772.  # -------------------------------------------------------------------------
  773.  ##
  774. proc registerFilesetMenuName {fset name {proc ""}} {
  775.     global subMenuInfo subMenuFilesetInfo
  776.     if { $fset == $name && [info exists subMenuFilesetInfo($fset)] } {
  777.     # if the fileset already has a base menu, use that:
  778.     foreach n $subMenuFilesetInfo($fset) {
  779.         if { [string trimright $n] == $fset } {
  780.         set base $n
  781.         } 
  782.         unset subMenuInfo($n)
  783.     }
  784.     unset subMenuFilesetInfo($fset)
  785.     }
  786.     set original $name                    
  787.     if {[info exists base]} {
  788.     set name $base
  789.     } else {
  790.     # I add at least one space to _all_ hierarchical submenus now.
  791.     # This is so I won't clash with any current or future modes
  792.     # which should never normally add spaces themselves.
  793.     append name " "
  794.     while { [info exists subMenuInfo($name)] } {
  795.         append name " "
  796.     }        
  797.     }
  798.     
  799.     set subMenuInfo($name) [list "$fset" "$original" "$proc"]
  800.     # build list of a fileset's menus
  801.     lappend subMenuFilesetInfo($fset) "$name"
  802.     
  803.     return $name
  804. }
  805.  
  806.  
  807. proc realMenuName {name} {
  808.     global subMenuInfo
  809.     return [lindex $subMenuInfo($name) 1]
  810. }
  811.  
  812. ## 
  813.  # -------------------------------------------------------------------------
  814.  #     
  815.  #    "subMenuProc" --
  816.  #    
  817.  # This procedure is implicitly used to deal with ensuring unique sub-menu
  818.  # names.  It calls the procedure you asked for, with the name of the menu
  819.  # you think you're using. 
  820.  # -------------------------------------------------------------------------
  821.  ##
  822. proc subMenuProc {menu item} {
  823.     global subMenuInfo
  824.     set l $subMenuInfo($menu)
  825.     set realProc [lindex $l 2]
  826.     if {[info commands $realProc] == ""} {catch "$realProc"}
  827.     # try to call the proc with three arguments (fileset is 1st)
  828.     if {[llength [info args $realProc]] == 2} {
  829.     $realProc [lindex $l 1] "$item"
  830.     } else {
  831.     $realProc [lindex $l 0] [lindex $l 1] "$item"
  832.     }
  833. }
  834.  
  835.  
  836. proc filesetMenuProc {menu item} {
  837.     switch $item {
  838.     "Edit File" {
  839.         editFile
  840.         return
  841.     } 
  842.     "Help" {
  843.         global HOME
  844.         edit [file join $HOME Help "Filesets Help"]
  845.         return
  846.     }
  847.     }
  848. }
  849.  
  850. ## 
  851.  # -------------------------------------------------------------------------
  852.  #     
  853.  #    "filesetProc" --
  854.  #    
  855.  # Must be called by 'subMenuProc'
  856.  # -------------------------------------------------------------------------
  857.  ##
  858. proc filesetProc {fset menu item} {
  859.     global gfileSetsType 
  860.     if {$fset != ""} {set m $fset} else { set m $menu}
  861.     switch -- $gfileSetsType($m) {
  862.     "fromDirectory" -
  863.     "think" -
  864.     "codewarrior" -
  865.     "fromOpenWindows" {
  866.         if {[catch {filesetBasicOpen $m $item}]} {
  867.         if {[dialog::yesno "That file wasn't found.  That fileset is probably out of date; do you want to rebuild it?"]} {
  868.             updateAFileset $fset
  869.         }
  870.         }
  871.     }
  872.     "ftp" { ftpFilesetOpen $m $item }
  873.     "default" {
  874.         # try a type-specific method first
  875.         set proc $gfileSetsType($m)FilesetSelected
  876.         if {[info commands $proc] == "" && (![auto_load $proc])} {
  877.         # if that failed then just hope it's an ordinary list
  878.         if {![catch {filesetBasicOpen $m $item}]} {return}
  879.         } else {
  880.         if {[llength [info args $proc]] == 2} {
  881.             if {![catch {eval [list $proc $menu $item]}]} {return}
  882.         } else {
  883.             if {![catch {eval [list $proc $fset $menu $item]}]} {return}
  884.         }
  885.         }
  886.         
  887.         if {[dialog::yesno "That file wasn't found.  That fileset is probably out of date; do you want to rebuild it?"]} {
  888.         updateAFileset $fset
  889.         }
  890.     }
  891.     }
  892. }
  893.  
  894. proc filesetBasicOpen { menu item } {
  895.     global file::separator
  896.     if {[set match [lsearch [getFilesInSet $menu] *${file::separator}$item]] >= 0} {
  897.     autoUpdateFileset $menu
  898.     generalOpenFileitem [lindex [getFilesInSet $menu] $match]
  899.     return
  900.     }
  901.     error "file not found"
  902. }
  903.  
  904. ## 
  905.  # -------------------------------------------------------------------------
  906.  # 
  907.  # "generalOpenFileitem" --
  908.  # 
  909.  #  Works around an alpha bug with aliases.
  910.  # -------------------------------------------------------------------------
  911.  ##
  912. proc generalOpenFileitem {file} {
  913.     if {[file isfile $file]} {
  914.     file::openAny $file
  915.     } else {
  916.     # is it an alias?
  917.     if {[file type $file] == "unknown"} {
  918.         getFileInfo $file a
  919.         # is it a folder?
  920.         if {$a(type) != "fdrp"} {
  921.         file::openAny $file
  922.         return
  923.         }
  924.     }
  925.     global file::separator
  926.     findFile "${file}${file::separator}"
  927.     }
  928. }
  929.  
  930. proc registerUpdateProcedure { type proc } {
  931.     global filesetUpdateProcs
  932.     lappend filesetUpdateProcs($type) $proc
  933. }
  934.  
  935. proc filesetUtilsProc { menu item } {
  936.     global filesetUtils gfileSetsType currFileSet
  937.     if {[info exists filesetUtils($item)]} {
  938.     # it's a utility
  939.     set utilDesc $filesetUtils($item)
  940.     set allowedTypes [lindex $utilDesc 0]
  941.     if {[string match $allowedTypes $gfileSetsType($currFileSet)]} {
  942.         return [eval [lindex $utilDesc 1]]
  943.     } else {
  944.         beep
  945.         message "That utility can't be applied to the current file-set."
  946.         return
  947.     }
  948.     } else {
  949.     $item
  950.     }
  951. }
  952. proc getFilesInSet {fset} {
  953.     global gfileSets fileSetsTypesThing gfileSetsType
  954.     switch -- $fileSetsTypesThing($gfileSetsType($fset)) {
  955.     "list" {
  956.         return $gfileSets($fset)
  957.     }
  958.     "glob" {
  959.         global filesetmodeVars fileSetsExtra
  960.         if {$filesetmodeVars(includeNonTextFiles)} {
  961.         set l [glob -nocomplain -dir [file dirname "$gfileSets($fset)"] -- [file tail "$gfileSets($fset)"]]
  962.         if {[info exists fileSetsExtra($fset)]} {
  963.             foreach pat $fileSetsExtra($fset) {
  964.             foreach f [glob -nocomplain -dir [file dirname "$gfileSets($fset)"] -- $pat] {
  965.                 set i [lsearch $l $f]
  966.                 set l [lreplace $l $i $i]
  967.             }
  968.             }
  969.         }
  970.         return $l
  971.         } else {
  972.         set l [glob -t TEXT -nocomplain -dir [file dirname "$gfileSets($fset)"] -- [file tail "$gfileSets($fset)"]]
  973.         if {[info exists fileSetsExtra($fset)]} {
  974.             foreach pat $fileSetsExtra($fset) {
  975.             foreach f [glob -t TEXT -nocomplain -dir [file dirname "$gfileSets($fset)"] -- $pat] {
  976.                 set i [lsearch $l $f]
  977.                 set l [lreplace $l $i $i]
  978.             }
  979.             }
  980.         }
  981.         return $l
  982.         }
  983.     }
  984.     "procedural" {
  985.         return [$gfileSets($fset)]
  986.     }        
  987.     "default" {
  988.         global fileSets
  989.         if {![info exists fileSets($fset)]} {
  990.         # This means the menu was cached, but this info wasn't.
  991.         # We calculate the set, and menu, and cache them
  992.         # (since they're at the end of the file, they over-ride
  993.         # what's there.
  994.         
  995.         # we rebuild the menu too
  996.         eval [makeFileSetAndMenu $fset 1]
  997.         cache::add filesetMenuCache "variable" fileSets($fset)
  998.         }
  999.         return $fileSets($fset)
  1000.     }
  1001.     }
  1002. }
  1003.  
  1004. proc makeFileSetAndMenu {name andMenu {use_cache 0}} {
  1005.     if {$use_cache} {
  1006.     set m [cache::snippetRead $name]
  1007.     if {$m != ""} {return $m}
  1008.     }
  1009.     global gfileSetsType fileSetsTypesThing
  1010.     message "Building ${name}..."
  1011.     set type $gfileSetsType($name)
  1012.     switch -- $fileSetsTypesThing($type) {
  1013.     "list" -
  1014.     "glob" {
  1015.         if {$andMenu} {
  1016.         set menu {}
  1017.         foreach m [getFilesInSet $name] {
  1018.             lappend menu "[file tail $m]&"
  1019.         }
  1020.         set m [makeFilesetSubMenu $name $name filesetProc [lsort -increasing $menu]]
  1021.         } else {
  1022.         return
  1023.         }
  1024.     }
  1025.     "procedural" {
  1026.         return
  1027.     }
  1028.     "default" {
  1029.         set m [${type}MakeFileSetAndMenu $name $andMenu]
  1030.         
  1031.     }
  1032.     }     
  1033.     cache::snippetWrite $name $m
  1034.     return $m
  1035. }
  1036.  
  1037. proc filesetsSorted { order usedvar {use_cache 0}} {
  1038.     upvar $usedvar used
  1039.     global filesetmodeVars gfileSets gfileSetsType
  1040.     set sets {}
  1041.     foreach item $order {
  1042.     switch -- [lindex $item 0] {
  1043.         "-" { 
  1044.         # add divider
  1045.         lappend sets "(-" 
  1046.         continue
  1047.         } 
  1048.         "*" {
  1049.         # add all the rest
  1050.         set subset {}
  1051.         foreach s [array names gfileSets] {
  1052.             if {![lcontains used $s]}  {
  1053.             lappend subset $s
  1054.             lappend used $s
  1055.             }
  1056.         }
  1057.         foreach f [lsort $subset] {
  1058.             lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1059.         }
  1060.         } 
  1061.         "pattern" {
  1062.         # find all which match a given pattern
  1063.         set patt [lindex $item 1]
  1064.         set subset {}
  1065.         foreach s [array names gfileSets] {
  1066.             if {![lcontains used $s]}  {
  1067.             if {[string match $patt $s]} {
  1068.                 lappend subset $s
  1069.                 lappend used $s
  1070.             }
  1071.             }
  1072.         }
  1073.         foreach f [lsort $subset] {
  1074.             lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1075.         }
  1076.         
  1077.         }
  1078.         "submenu" {
  1079.         # add a submenu with name following and sub-order
  1080.         set name [lindex $item 1]
  1081.         set suborder [lrange $item 2 end]              
  1082.         # we make kind of a pretend fileset here.
  1083.         set subsets [filesetsSorted $suborder used]
  1084.         if { $subsets != "" } {
  1085.             lappend sets [makeFilesetSubMenu $name $name filesetProc $subsets]
  1086.         }
  1087.         }
  1088.         "default" {        
  1089.         set subset {} 
  1090.         foreach s [array names gfileSets] {
  1091.             if {[lcontains item $gfileSetsType($s)] && ![lcontains used $s]}  {
  1092.             lappend subset $s
  1093.             lappend used $s
  1094.             }
  1095.         }
  1096.         foreach f [lsort $subset] {
  1097.             lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1098.         }
  1099.         }
  1100.     }
  1101.     
  1102.     }
  1103.     # remove multiple and leading, trailing '-' in case there were gaps
  1104.     regsub -all {\(-( \(-)+} $sets {(-} sets
  1105.     while { [lindex $sets 0] == "(-" } { set sets [lrange $sets 1 end] }
  1106.     set l [expr {[llength $sets] -1}]
  1107.     if { [lindex $sets $l] == "(-" } { set sets [lrange $sets 0 [incr l -1]] }
  1108.     
  1109.     return $sets
  1110. }
  1111.  
  1112. ## 
  1113.  # -------------------------------------------------------------------------
  1114.  # 
  1115.  # "rebuildFilesetMenu" --
  1116.  # 
  1117.  #  Reads the fileset menu from the cache if it exists.  This speeds up
  1118.  #  start-up by quite a bit.
  1119.  # -------------------------------------------------------------------------
  1120.  ##
  1121. proc rebuildFilesetMenu {} { 
  1122.     message "Building filesets..."
  1123.     if {[cache::exists filesetMenuCache]} {
  1124.     global subMenuFilesetInfo subMenuInfo fileSets
  1125.     cache::readContents filesetMenuCache 
  1126.     rebuildFilesetUtilsMenu
  1127.     callFilesetUpdateProcedures
  1128.     } else {
  1129.     rebuildAllFilesets 1
  1130.     }
  1131.     
  1132. }
  1133.     
  1134. ## 
  1135.  # -------------------------------------------------------------------------
  1136.  #     
  1137.  #    "zapAndBuildFilesets" --
  1138.  #    
  1139.  # This does a complete rebuild of all information.  The problem is that
  1140.  # the names of menus may actually change (spaces added/deleted).  This is
  1141.  # not a problem for the fileset menu, but is a problem for any filesets
  1142.  # which have been added to other menus, since they won't know that they
  1143.  # need to be rebuilt. 
  1144.  # -------------------------------------------------------------------------
  1145.  ##
  1146. proc zapAndBuildFilesets {} {
  1147.     global subMenuInfo subMenuFilesetInfo
  1148.     unset subMenuInfo
  1149.     unset subMenuFilesetInfo
  1150.     rebuildAllFilesets
  1151. }
  1152.  
  1153. proc rebuildAllFilesets { {use_cache 0} } {
  1154.     global gfileSets filesetMenu  filesetSortOrder 
  1155.     global filesetmodeVars filesetsNotInMenu fileSets
  1156.     message "Rebuilding filesets menu…"
  1157.     
  1158.     if {$filesetmodeVars(sortFilesetsByType)} {
  1159.     # just make file-sets for those we don't want in the menu
  1160.     if {!$use_cache} {
  1161.         foreach f $filesetsNotInMenu {
  1162.         makeFileSetAndMenu $f 0 
  1163.         }
  1164.     }
  1165.     set used $filesetsNotInMenu
  1166.     set sets [filesetsSorted $filesetSortOrder used $use_cache]
  1167.     } else {
  1168.     foreach f [lsort [array names gfileSets]] {
  1169.         set doMenu [expr {![lcontains filesetsNotInMenu $f]}]
  1170.         set menu [makeFileSetAndMenu $f $doMenu $use_cache]
  1171.         if {$doMenu && [llength $menu]} {
  1172.         lappend sets $menu
  1173.         }        
  1174.     }            
  1175.     }
  1176.     
  1177.     regsub -all {[-][nm]} $sets "" names
  1178.     foreach nn $names {
  1179.     lappend names_ [string trimright [lindex $names 1]]
  1180.     }
  1181.     set names $names_
  1182.     
  1183.     # cache the fileset menu
  1184.     set m [list Menu -m -n $filesetMenu -p filesetMenuProc \
  1185.       [concat {{/'Edit File…} {Menu -n Utilities {}}} "Help" \
  1186.       "(-" $sets]]
  1187.     cache::create filesetMenuCache 
  1188.     cache::add filesetMenuCache "eval" $m [list insertMenu $filesetMenu]
  1189.     global subMenuFilesetInfo subMenuInfo
  1190.     cache::add filesetMenuCache "variable" subMenuFilesetInfo subMenuInfo fileSets
  1191.     eval $m
  1192.     
  1193.     rebuildFilesetUtilsMenu
  1194.     callFilesetUpdateProcedures
  1195.     
  1196.     message ""
  1197. }
  1198.  
  1199. ## 
  1200.  # -------------------------------------------------------------------------
  1201.  #     
  1202.  #    "rebuildSomeFilesetMenu" --
  1203.  #    
  1204.  # If given '*' rebuild the entire menu, else rebuild only those types
  1205.  # given.  This is generally useful to avoid excessive rebuilding when
  1206.  # flags are adjusted
  1207.  # -------------------------------------------------------------------------
  1208.  ##
  1209. proc rebuildSomeFilesetMenu {args} {
  1210.     rebuildAllFilesets        
  1211. }
  1212.  
  1213. proc rebuildFilesetUtilsMenu {} {
  1214.     global gfileSets filesetUtils 
  1215.     
  1216.     Menu -n "Utilities" -p filesetUtilsProc [concat \
  1217.       "newFileset…" \
  1218.       "deleteFileset…" \
  1219.       "printFileset…" \
  1220.       "<S<EupdateAFileset…" \
  1221.       "<SupdateCurrentFileset" \
  1222.       "<S<EzapAndBuildFilesets" \
  1223.       "<SrebuildAllFilesets" \
  1224.       [list [menu::makeFlagMenu choose list currFileSet]] \
  1225.       [list [list Menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]]] \
  1226.       [list [menu::makeFlagMenu filesetFlags array filesetmodeVars]] \
  1227.       "(-" \
  1228.       "/T<I<OfindTag" \
  1229.       "createTagFile" \
  1230.       "(-" \
  1231.       [lsort [array names filesetUtils]] \
  1232.       ]
  1233.     
  1234.     filesetUtilsMarksTicks
  1235. }
  1236.  
  1237. proc rebuildSimpleFilesetMenus {} {
  1238.     global gfileSets fileSetsTypesThing
  1239.     eval [menu::makeFlagMenu choose list currFileSet]
  1240.     Menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]
  1241.     filesetUtilsMarksTicks
  1242. }
  1243.  
  1244. proc hideShowFileset {menu item} {
  1245.     global filesetsNotInMenu filesetMenu
  1246.     if {[lcontains filesetsNotInMenu $item]} {
  1247.     global gfileSetsType
  1248.     if {$gfileSetsType($item) == "procedural"} {
  1249.         alertnote "Sorry, procedural filesets are completely dynamic and cannot appear in menus."
  1250.         return
  1251.     }
  1252.     set idx [lsearch $filesetsNotInMenu $item]
  1253.     set filesetsNotInMenu [lreplace $filesetsNotInMenu $idx $idx]        
  1254.     markMenuItem -m hideFileset $item off
  1255.     # would be better if we could just insert it
  1256.     rebuildAllFilesets 1
  1257.     } else {
  1258.     lappend filesetsNotInMenu $item
  1259.     markMenuItem -m hideFileset $item on
  1260.     if {[catch {removeFilesetFromMenu $item}]} {
  1261.         rebuildAllFilesets 1
  1262.     }
  1263.     }
  1264.     global modifiedVars
  1265.     lappend modifiedVars filesetsNotInMenu
  1266. }
  1267.  
  1268. proc filesetUtilsMarksTicks {} {
  1269.     global filesetsNotInMenu
  1270.     
  1271.     foreach name $filesetsNotInMenu {
  1272.     markMenuItem -m hideFileset $name on
  1273.     }
  1274.     
  1275. }
  1276.  
  1277.  
  1278. # Called in response to user changing filesets from the fileset menu.
  1279. proc changeFileSet {item} {
  1280.     global currFileSet tagFile
  1281.     # Bring in the tags file for this fileset
  1282.     set fname [tagFileName]
  1283.     if {[file exists $fname]} {
  1284.     if {[dialog::yesno "Use tag file from folder \"$dir\" ?"]} {
  1285.         set tagFile $fname
  1286.     }
  1287.     }
  1288. }
  1289.  
  1290. proc autoUpdateFileset { name } {
  1291.     global currFileSet filesetmodeVars modifiedVars
  1292.     if {$filesetmodeVars(autoAdjustFileset)} {
  1293.     set currFileSet $name
  1294.     lunion modifiedVars currFileSet
  1295.     }
  1296. }
  1297.  
  1298.  
  1299. # ◊◊◊◊ Utility procs ◊◊◊◊ #
  1300.  
  1301. proc isWindowInFileset { {win "" } {type ""} } {
  1302.     if {$win == ""} { set win [win::Current] }
  1303.     global currFileSet gfileSets gfileSetsType
  1304.     
  1305.     if { $type == "" } {
  1306.     set okSets [array names gfileSets]
  1307.     } else {
  1308.     set okSets {}
  1309.     foreach s [array names gfileSets] {
  1310.         if { $gfileSetsType($s) == $type } {
  1311.         lappend okSets $s
  1312.         }
  1313.     }
  1314.     }
  1315.     
  1316.     if {[array exists gfileSets]} {
  1317.     if {[lsearch -exact $okSets $currFileSet] != -1 } {
  1318.         # check current fileset
  1319.         if {[lsearch -exact [getFilesInSet $currFileSet] $win] != -1 } {
  1320.         # we're set, it's in this fileset
  1321.         return  $currFileSet
  1322.         }
  1323.     }
  1324.     
  1325.     # check other fileset
  1326.     foreach fset $okSets {
  1327.         if {[lsearch -exact [getFilesInSet $fset] $win] != -1 } {
  1328.         # we're set, it's in this project
  1329.         return  $fset
  1330.         }
  1331.     }   
  1332.     }
  1333.     return ""
  1334.     
  1335. }
  1336.  
  1337.  
  1338.  
  1339. ## 
  1340.  # -------------------------------------------------------------------------
  1341.  #     
  1342.  #    "iterateFileset" --
  1343.  # 
  1344.  #  Utility procedure to iterate over all files in a project, calling some
  1345.  #  predefined function '$fn' for each member of project '$proj'.  The
  1346.  #  results of such a call are passed to '$resfn' if given.  Finally "done"
  1347.  #  is passed to 'resfn'.
  1348.  #     
  1349.  # -------------------------------------------------------------------------
  1350.  ##
  1351. proc iterateFileset { proj fn { resfn \# } } {
  1352.     global gfileSets gfileSetsType
  1353.     eval $resfn "first"
  1354.     
  1355.     set check [expr {![catch {$gfileSetsType($proj)IterateCheck check}]}]
  1356.     
  1357.     foreach ff [getFileSet $proj] {
  1358.     if { $check && [$gfileSetsType($proj)IterateCheck $proj $ff] } {
  1359.         continue
  1360.     }
  1361.     set res [eval $fn [list $ff]]
  1362.     eval $resfn [list $res]
  1363.     }
  1364.     
  1365.     if {$check} {
  1366.     catch {$gfileSetsType($proj)IterateCheck done}
  1367.     }
  1368.     
  1369.     eval $resfn "done"
  1370.     
  1371. }
  1372.  
  1373. # ◊◊◊◊ Tags ◊◊◊◊ #
  1374.  
  1375. if {![string length [info commands alphaFindTag]]} {
  1376.     rename findTag alphaFindTag
  1377.     rename createTagFile alphaCreateTagFile
  1378. }
  1379.  
  1380. proc tagFileName {} {
  1381.     global gfileSets currFileSet 
  1382.     return [file join [file dirname [car $gfileSets($currFileSet)]] "[join ${currFileSet}]TAGS"]
  1383. }
  1384.  
  1385. proc findTag {} {
  1386.     global gfileSetsType currFileSet
  1387.     # try a type-specific method first
  1388.     if {[catch {$gfileSetsType($currFileSet)FindTag}]} {
  1389.     alphaFindTag
  1390.     }
  1391. }
  1392.  
  1393. proc createTagFile {} {
  1394.     global gfileSetsType currFileSet tagFile modifiedVars
  1395.     set tagFile [tagFileName]
  1396.     lappend modifiedVars tagFile
  1397.     
  1398.     # try a type-specific method first
  1399.     if {[catch {$gfileSetsType($currFileSet)CreateTagFile}]} {
  1400.     alphaCreateTagFile
  1401.     }
  1402. }
  1403.  
  1404. # ◊◊◊◊ Utils ◊◊◊◊ #
  1405.  
  1406.     
  1407. proc dirtyFileset { fset } {
  1408.     foreach f [getFilesInSet $fset] {
  1409.     if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { return 1 }
  1410.     }
  1411.     return 0
  1412. }
  1413.  
  1414. proc saveEntireFileset { fset } {
  1415.     foreach f [getFilesInSet $fset] {
  1416.     if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { 
  1417.         bringToFront $f
  1418.         save 
  1419.     }
  1420.     }
  1421. }
  1422.  
  1423. proc closeEntireFileset { {fset ""} } {
  1424.     if {[catch {pickFileset $fset "Close which fileset?" "popup"} fset]} {return}
  1425.     
  1426.     foreach f [getFilesInSet $fset] {
  1427.     if {![catch {getWinInfo -w $f arr}]} {
  1428.         bringToFront $f
  1429.         killWindow
  1430.     }
  1431.     }
  1432. }
  1433.  
  1434. proc fileToAlpha {f} {
  1435.     if {[file isfile $f] && ([getFileType $f] == "TEXT") && ([getFileSig $f] != "ALFA")} {
  1436.     message "Converting $f"
  1437.     setFileInfo $f creator ALFA
  1438.     }    
  1439. }
  1440.  
  1441. proc filesetToAlpha {} {
  1442.     if {[catch {pickFileset "" {Convert all files from which fileset?} "popup"} fset]} {return}
  1443.     iterateFileset $fset fileToAlpha
  1444. }
  1445.  
  1446. ## 
  1447.  # -------------------------------------------------------------------------
  1448.  # 
  1449.  # "replaceInFileset" --
  1450.  # 
  1451.  #  Quotes things correctly so searches work, and adds a check on
  1452.  #  whether there are any windows.
  1453.  # -------------------------------------------------------------------------
  1454.  ##
  1455. proc replaceInFileset {} {
  1456.     global gfileSets win::NumDirty
  1457.     set how [dialog::optionMenu "Search type:" \
  1458.       [list "Textual replace" "Case-independent textual replace" \
  1459.       "Regexp replace" "Case-independent regexp replace"] "" 1]
  1460.     set from [prompt "Search string:" [searchString]]
  1461.     searchString $from
  1462.     if {$how < 2} {set from [quote::Regfind $from]}
  1463.     
  1464.     set to [prompt "Replace string:" [replaceString]]
  1465.     replaceString $to
  1466.     if {$how < 2} {set to [quote::Regsub $to]}
  1467.     if {[catch {regsub -- $from "$from" $to dummy} err]} {
  1468.     alertnote "Regexp compilation problems: $err"
  1469.     return
  1470.     }
  1471.     set fsets [pickFileset "" "Which filesets?" "multilist"]
  1472.     
  1473.     if {${win::NumDirty}} {
  1474.     if {[buttonAlert "Save all windows?" "Yes" "Cancel"] != "Yes"} return
  1475.     saveAll
  1476.     }
  1477.     
  1478.     set cid [scancontext create]
  1479.     set changes 0
  1480.     if {$how & 1} {
  1481.     set case "-nocase"
  1482.     } else {
  1483.     set case "--"
  1484.     }
  1485.     
  1486.     scanmatch $case $cid $from {set matches($f) 1 ;incr changes}
  1487.     foreach fset $fsets {
  1488.     foreach f [getFileSet $fset] {
  1489.         if {![catch {set fid [open $f]}]} {
  1490.         message "Looking at '[file tail $f]'"
  1491.         scanfile $cid $fid
  1492.         close $fid
  1493.         }
  1494.     }
  1495.     }
  1496.     
  1497.     scancontext delete $cid
  1498.     
  1499.     foreach f [array names matches] {
  1500.     message "Modifying ${f}…"
  1501.     set cid [open $f "r"]
  1502.     if {[regsub -all $case $from [read $cid] $to out]} {
  1503.         set ocid [open $f "w+"]
  1504.         puts -nonewline $ocid $out
  1505.         close $ocid
  1506.     }
  1507.     close $cid
  1508.     }
  1509.     
  1510.     eval file::revertThese [array names matches]
  1511.     message "Replaced $changes instances"
  1512. }
  1513.  
  1514. proc openEntireFileset {} {
  1515.     set fset [pickFileset "" "Open which fileset?" "popup"]
  1516.     
  1517.     # we use our iterator in case there's something special to do
  1518.     iterateFileset $fset "edit -c -w"
  1519. }
  1520.  
  1521. proc openFilesetFolder {} {
  1522.     global gfileSets
  1523.     set fset [pickFileset "" "Open which fileset's folder?" "popup"]
  1524.     if {[llength [list $gfileSets($fset)]] == 1 && [file isdirectory [set dir [file dirname $gfileSets($fset)]]]} {
  1525.     openFolder $dir
  1526.     } else {
  1527.     alertnote "Fileset not connected to a folder."
  1528.     }
  1529. }
  1530.  
  1531. proc stuffFileset {} {
  1532.     global gfileSetsType gfileSets
  1533.     set fset [pickFileset "" "Which fileset shall I stuff?" "popup"]
  1534.     if {[string length $fset]} {
  1535.     if { $gfileSetsType($fset) == "fromDirectory" && \
  1536.       [dialog::yesno "Stuff entire directory?"]} {
  1537.         app::launchFore DStf
  1538.         regexp {ZZ(.)ZZ} [file join ZZ ZZ] "" separator
  1539.         sendOpenEvent reply 'DStf' "[file dirname $gfileSets($fset)]${separator}"
  1540.     } else {            
  1541.         app::launchFore DStf
  1542.         eval sendOpenEvents 'DStf' [getFilesInSet $fset]
  1543.     }        
  1544.     sendQuitEvent 'DStf'
  1545.     }
  1546. }
  1547.  
  1548. proc filesetRememberOpenClose { file } {
  1549.     global fileset_openorclosed
  1550.     set fileset_openorclosed [list "$file" [lsearch -exact [winNames -f] $file]]
  1551. }
  1552.  
  1553. proc filesetRevertOpenClose { file } {
  1554.     global fileset_openorclosed
  1555.     if { [lindex $fileset_openorclosed 0] == "$file" } {
  1556.     if { [lindex $fileset_openorclosed 1] < 0 } {
  1557.         killWindow
  1558.     }
  1559.     }    
  1560.     catch {unset fileset_openorclosed}
  1561. }
  1562.  
  1563. proc wordCountFileset {} {
  1564.     global currFileSet
  1565.     iterateFileset $currFileSet wordCountProc filesetUtilWordCount
  1566. }
  1567.  
  1568. proc filesetUtilWordCount {count} {
  1569.     global fs_ccount fs_wcount fs_lcount
  1570.     switch $count {
  1571.     "first" {
  1572.         set fs_ccount 0
  1573.         set fs_wcount 0
  1574.         set fs_lcount 0
  1575.     }       
  1576.     "done" {
  1577.         alertnote "There were $fs_ccount lines, $fs_wcount words and $fs_lcount chars"
  1578.         unset fs_ccount fs_wcount fs_lcount
  1579.     }
  1580.     default {
  1581.         incr fs_ccount [lindex $count 2]
  1582.         incr fs_wcount [lindex $count 1]
  1583.         incr fs_lcount [lindex $count 0]
  1584.     }
  1585.     }
  1586. }
  1587.  
  1588.  
  1589. ## 
  1590.  # -------------------------------------------------------------------------
  1591.  # 
  1592.  # "wordCountProc" --
  1593.  # 
  1594.  #  Completely new proc which does the same as the old one
  1595.  #  without opening lots of windows.
  1596.  #  *Very* memory comsuming for large files, though.
  1597.  #  But I think the old one was equally memeory consuming.
  1598.  #  
  1599.  #  Ok, this is not exactly a bug fix. It's a IMHO better option.
  1600.  #  
  1601.  # -------------------------------------------------------------------------
  1602.  ##
  1603.  
  1604. proc wordCountProc {file} {
  1605.     message "Counting [file tail $file]…"
  1606.     set fid [open $file r]
  1607.     set filecont [read $fid]
  1608.     close $fid
  1609.     if {[regexp {\n\r} $filecont]} {
  1610.     set newln "\n\r"
  1611.     } elseif {[regexp {\n} $filecont]} {
  1612.     set newln "\n"
  1613.     } else {
  1614.     set newln "\r"
  1615.     }
  1616.     set lines [expr {[regsub -all -- $newln $filecont " " filecont] + 1}]
  1617.     set chars [string length $filecont]
  1618.     regsub -all {[!=;.,\(\#\=\):\{\"\}]} $filecont " " filecont
  1619.     set words [llength $filecont]
  1620.     return "$chars $words $lines"
  1621. }
  1622.  
  1623.  
  1624. # ◊◊◊◊ From search dialog ◊◊◊◊ #
  1625.  
  1626. proc findNewFileset {} {
  1627.     return [newFileset]
  1628. }
  1629.  
  1630.  
  1631. proc findNewDirectory {} {
  1632.     global gfileSets currFileSet gfileSetsType gDirScan
  1633.     
  1634.     set dir [get_directory -p "Scan which folder?"]
  1635.     if {![string length $dir]} return
  1636.     
  1637.     set filePat {*}
  1638.     set name [file tail $dir]
  1639.     
  1640.     set gfileSets($name) [file join $dir $filePat]
  1641.     set gDirScan($name) 1
  1642.     set gfileSetsType($name) "fromDirectory"
  1643.     set currFileSet $name
  1644.     updateCurrentFileset
  1645.     return $name
  1646. }
  1647.  
  1648. # Should be last so all filesets make it in.
  1649. rebuildFilesetMenu
  1650.  
  1651.  
  1652.  
  1653.  
  1654.  
  1655.  
  1656.  
  1657.  
  1658.